perm filename XAP[XGP,BGB] blob
sn#044862 filedate 1973-05-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00029 PAGES
C REC PAGE DESCRIPTION
C00001 00001 VALID 00029 PAGES
C00004 00002 TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
C00008 00003 XGP RASTER PAGE BUFFER.
C00009 00004 ALTERNATE PDP-10 MNEMONICS.
C00012 00005 START ADDRESS ENTRY.
C00014 00006 RUN SCANNER OVER EACH PAGE FOUR FUCKING TIMES.
C00016 00007 SUBR(XXTEXT) EXECUTE ONE TEXT CHARACTER.
C00018 00008 SUBR(MKTABL) MAKE 2D BIT ADDRESSING TABLE.
C00021 00009 SUBR(XGPOUT) OUTPUT BUFFER TO XGP.
C00023 00010 SUBR(PRINT)CHR PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
C00026 00011 SUBR(LSD) LINE SEGMENT DISPLAY.
C00029 00012 SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
C00031 00013 FETCH AND DECODE III COMMAND WORD.
C00033 00014
C00036 00015 SUBR(GETFIL) GET FILE SPEC FROM TTY LINE.
C00038 00016 SUBR(INITIO) GET AND OPEN A CHANNEL.
C00039 00017 SUBR(GETCHR) GET CHARACTER AND SKIP.
C00042 00018 SUBR(INITXT) INITIALIZE TEXT FILE.
C00043 00019 SUBR(DEFONT) DEFINE FONT N.
C00045 00020 SUBR(SETFNT) SETUP A FONT.
C00046 00021 --- ASCII 00 TO 37.
C00047 00022 --- ASCII 40 TO 77.
C00048 00023 --- ASCII 100 TO 137. UPPER CASE COMMANDS.
C00049 00024 --- ASCII 140 TO 177. LOWER CASE COMMANDS.
C00050 00025 COMMAND EXECUTION.
C00052 00026 SUBR(MODE0)
C00057 00027 SUBR(SQRT)
C00059 00028 BEGIN SINCOS SINE & COSINE - BGB.
C00061 00029 SUBR(REALIN)
C00064 ENDMK
C⊗;
TITLE XAP - XEROX ASSEMBLE AND PRINT - BGB - 27 JANUARY 1973.
;JOB DATA AREA AND CORE MAP.
PDL: BLOCK 100 ;CONTROL PUSH DOWN.
PAT: BLOCK 100 ;PATCH AREA.
EXTERN JOBJDA ;140 END OF JOB DATA AREA.
EXTERN JOBFF ;121 TOP OF USED CORE POINTER.
EXTERN JOBSA ;120 XWD ORGINAL-TOP,START-ADDR.
EXTERN JOBREL ; 44 PHYSICAL TOP OF CORE IMAGE.
ORGXGP:0 ;XGP BUFFER (1/4 OF A PAGE).
ENDXGP:0
;XAP SCANNER STATUS.
QPAGE:0 ;QUARTER PAGE.
QLO:0↔QHI:0 ;QUARTER ROW LOW & QUARTER ROW HI.
MODE:0 ;-1 COMMAND MODE. 0 TEXT MODE.
CHAR:0 ;CURRENT CHARACTER.
;DSK I/O DATA AREA.
FILNAM: 0 ;FILE NAME.
EXTION: 0↔0 ;EXTENSION.
PPPN: 0↔0 ;PROJECT-PROGRAMMER.
IOPTR: 0 ;POINTER INTO FILE STACK
IBUF: BLOCK 4*MAXFILES ;FILE STACK
CHANTB←IBUF+3
TTYFLG: 0 ;INPUT FROM TTY
RPGFLG: 0
TXTPTR: IOWD 44,TXTPDL
TXTPDL: BLOCK 44 ;PUSH DOWN OF TEXT POINTERS.
;FONT SPECIFICATION.
FONT: 0
FONTAB: BLOCK 20
FNTPPN: SIXBIT/XGPSYS/ ;DEFAULT FONT PPN
;XGP RASTER PAGE BUFFER.
ROW:0↔COL:0 ;XGP "PEN" POSITION.
DROW:0↔DCOL:0 ;DELTA PEN POSITION FOR LINE FEED AND SPACE.
MAXFILES←←5 ;NUMBER OF INDIRECTED FILES
;XGP RASTER DIMENSIONS.
WWIDTH←←=49 ;WORD WIDTH OF A ROW.
NCOLS←←(WWIDTH-1)*=36 ;NUMBER OF COLUMNS IS 1728.
MROWS←←=2048 ;NUMBER OF ROWS IS 2048.
BUFSIZ←←WWIDTH*MROWS/4 ;SIZE OF XGP BUFFER (ONE QUARTER PAGE).
;III BUFFER DISPLAY.
SCALEX: =1024
SCALEY: =1024
;TEXT JUSTIFICATION PARAMETERS.
RMAR:NCOLS↔LMAR:=100
ROWMIN:=100↔ROWMAX:MROWS
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FIXX,FIX 233000↔O DZM,SETZM
;SAIL LIKE SUBROUTINE LINKAGE.
↓P←←17
DEFINE SUBR(NAME){INTERN NAME↔↓NAME: ;}
DEFINE CALL(NAME,X1,X2,X3,X4){
IFDIF <> <X1> {PUSH 17,X1↔IFDIF <> <X2> {PUSH 17,X2
IFDIF <> <X3> {PUSH 17,X3↔IFDIF <> <X4> {PUSH 17,X4}}}}
PUSHJ 17,NAME}
DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12(21)"FAT"↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←←400000
;START ADDRESS ENTRY.
SA: TDCA↔SETA↔DAC RPGFLG↔CALLI ;SET RPG FLAG.
CAR JOBSA↔DAC JOBFF↔CORE↔JFCL ;CORE DOWN LOWER.
LACI =2047↔CORE2↔GO[FATAL(<CAN'T GET A 2ND SEGMENT.>)]
LAC P,[IOWD 100,PDL] ;INITIALIZE TABLES
SETZM FONTAB
LAC[XWD FONTAB,FONTAB+1]↔BLT FONTAB+9
SETZM LMAR↔LACI NCOLS↔DAC RMAR
;RE-ENTRY ADDRESS.
REE: LACI .↔DAC 124
LACI 4↔MOVNM IOPTR
SKIPE RPGFLG↔JFCL ;RPG ENTRY.
;INITIALIZE XGP BUFFER.
CDR JOBFF↔DAC ORGXGP↔CALL(MKTABL)
LAC[SIXBIT/LPTFNT/]
HLLZM FILNAM↔DIPZ EXTION
LAC FNTPPN↔DAC PPPN↔DZM FONT
CALL(<DEFONT+1>) ;DEFINE DEFAULT FONT.
CALL(MKBUF) ;MAKE XGP BUFFER.
;DEFAULT INITIALIZE MARGINS.
LACI =100↔DAC ROWMIN↔DAC ROW
LACI MROWS-=200↔DAC ROWMAX
LACI =100↔DAC LMAR↔DAC COL
LACI NCOLS↔DAC RMAR
SETOM TTYFLG ;FROM TTY.
SETOM MODE ;COMMAND MODE.
;RUN SCANNER OVER EACH PAGE FOUR FUCKING TIMES.
DZM QPAGE↔DZM QLO
LACI =511↔DAC QHI
;RESCAN COMMAND LINE FOR A SEMI-COLON.
RETTY: RESCAN↔INCHSL↔EXIT
CAIN 15↔EXIT
CAIE";"↔GO .-5
;ASSEMBLE A PHASE OF A PAGE._________________________________________
LOOP: CALL(GETCHR)↔GO FINISH ;EOF
DAC 1,CHAR
SKIPE MODE↔GO COMAND
CALL(XXTEXT)↔GO LOOP ;TEXT CHARACTERS.
COMAND: CALL(XXCOMM)↔GO LOOP ;COMMAND CHARACTERS.
FINISH:
LACI =512↔ADDM QLO↔ADDM QHI
AOS 1,QPAGE↔CAIGE 1,4↔GO RETTY
CALL(XGPOUT)↔CALLI 0 ;FLUSH BUFFERS
LAC JOBFF↔CORE↔JFCL ;FLUSH CORE.
SETZ↔CORE2↔JFCL
EXIT
;____________________________________________________________________
SUBR(XXTEXT) ;EXECUTE ONE TEXT CHARACTER.
BEGIN XXTEXT;_____________________________________________________
SKIPN 1,CHAR↔POP0J ;NULL.
CAIN 1,11↔GO[LAC COL↔SUB LMAR↔IDIV DCOL ;TAB.
ANDCMI 7↔ADDI 8↔IMUL DCOL↔ADD LMAR
DAC COL↔POP0J]
CAIN 1,15↔GO[LAC LMAR↔DAC COL↔POP0J] ;RETURN.
CAIN 1,14↔GO FFEED
CAIN 1,40↔GO SPACE
CAIN 1,12↔GO[LAC DROW↔ADDM ROW↔GO ROWCHK] ;LINE FEED
CAIN 1,32↔GO ESCAPE ;TILDE ESCAPE TEXT MODE.
CAIN 1,177↔GO MODE0 ;RUBOUT ESCAPE.
;ENTRY POINT FOR HIDDEN CHARACTERS
↑HIDDEN:CALL(PRINT,CHAR)↔GO COLCHK
SPACE: LAC DCOL↔ADDM COL
↑COLCHK:LAC COL↔CAMG RMAR↔GO ROWCHK ;COLUMN OVERFLOW - DEFAULT CRLF.
LAC LMAR↔DAC COL
LAC DROW↔ADDM ROW
↑ROWCHK:LAC ROW↔CAMGE ROWMAX↔POP0J ;ROW OVERFLOW -DEFAULT FF.
FFEED: CALL(XGPOUT) ;FORM FEED.
LAC ROWMIN↔DAC ROW
LAC LMAR↔DAC COL↔POP0J
ESCAPE: SETOM MODE↔POP0J
BEND XXTEXT;BGB 25 MAY 1973.______________________________________
SUBR(XXCOMM) ;EXECUTE COMMAND CHARACTER.
BEGIN XXCOMM;_____________________________________________________
SKIPN 1,CHAR↔POP0J
CDR 1,A00(1)
JUMPN 1,(1)
POP0J
BEND XXCOMM;BGB 25 MAY 1973.______________________________________
SUBR(MKTABL) ;MAKE 2D BIT ADDRESSING TABLE.
;TWO DIMENSION BIT ADDRESSING.
DEFINE DOT(R,C){HLLZ 1,%(C)↔ROT 1,6↔HRRI 1,@%(R)↔DPB 0,1}
COMMENT ⊗
The DOT macro places a bit at a given row and column of the
XGP buffer. The 2D bit address byte pointer is computed by twice
referencing a 2K table in which the Nth word contains the bytes
0:5(N div =36) 6:11(N mod =36) 12:17(01) 18:35(orgXGP+N*WWIDTH).
That is the left halfword of the Nth table entry contains the base
address of the Nth row; and the right halfword of the Nth table
entry contains a byte pointer to the Nth column. In the DOT macro,
the HLLZ and ROT instructions setup the column byte pointer and the
HRRI instruction (thru the magic of immediate indirect double
indexing) adds the right halfword of the Nth row table entry to the
byte pointer. The use of accumulator 1 is mandatory because of the
index-byte-size pun. The following subroutine initializes the table.⊗
BEGIN MKTABL;________________________________________________________
LAC[XWD L,1]↔BLT 11
LAC ORGXGP↔ADDI 2
TLO 4301
GO 3
L: XWD -100,WWIDTH ;1 INCREMENT.
XWD -=2048,% ;2 AOBJN TABLE POINTER.
DAC 0,(2) ;3
TLNN 0,7700 ;4 TEST FOR =36 OVERFLOW.
ADD 0,[144B11] ;5 INCREMENT COLUMN WORD COUNT.
ADD 0,1 ;6
AOBJN 2,3 ;7
POP0J ;8
BEND MKTABL;BGB 24 MAY 1973._________________________________________
SUBR(MKBUF) MAKE XGP BUFFER (ONE PHASE) 512 ROWS.
BEGIN MKBUF;------------------------------------------------------
;EXPAND CORE FOR XGP BUFFER.
CDR JOBFF↔DAC ORGXGP
ADDI BUFSIZ↔DAC ENDXGP↔AOS ORGXGP
ADDI 10↔DAC JOBFF↔IORI 1777
CALLI 11↔GO [FATAL(CAN'T GET CORE FOR XGP BUFFER)]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1↔BLT 1,@ENDXGP
POP0J
BEND MKBUF;BGB 27 JANUARY 1973.-----------------------------------
SUBR(XGPOUT) OUTPUT BUFFER TO XGP.
BEGIN XGPOUT;-----------------------------------------------------
;PUT CONTROL WORD IN EACH ROW.
LAC[1B11]↔ADDI WWIDTH-1
LAC 1,ORGXGP
LACI 2,MROWS/4 ;NUMBER OF ROWS IN A QUARTER PAGE.
DAC(1)↔ADDI 1,WWIDTH ;ROW WORD WIDTH.
SOJG 2,.-2
;CALL THE IOTS.
LAC ORGXGP↔SOS↔DAP OUT2
INIT 2,17↔SIXBIT/XGP/↔0↔HALT
SETZ 1,
SEGNUM 1,
DETSEG
LOCK
OUTSTR[ASCIZ/OUTPUTING PAGE TO XGP.../]
OUT 2,OUT1
SKIPA
OUTSTR[ASCIZ/XGP GAVE AN ERROR RETURN.
/]
UNLOCK
RELEASE 2,
OUTSTR[ASCIZ/PAGE FINISHED.
/]
JUMPE 1,.+3
ATTSEG 1,↔GO[OUTSTR[ASCIZ/ATTSEG FAILED. /]↔HALT .+1]
;CLEAR XGP BUFFER.
LAC 1,ORGXGP↔SETZM(1)
DIP 1,1↔AOS 1
CDR 2,ENDXGP↔BLT 1,(2)
POP0J
;-----------------------------------------------------------------
OUT1: IOWD 2,HACK1
OUT2: IOWD BUFSIZ,0
OUT3: IOWD 2,HACK2
0
HACK1: 1B0
1B0 + =19B11
HACK2: 1B0 + =19B11
0↔0
BEND;1/31/73------------------------------------------------------
SUBR(PRINT)CHR PLACE A GLYPH INTO XGP BUFFER AT ROW,COL.
BEGIN PRINT;------------------------------------------------------
ACCUMULATORS{G,B,B2,M,N,I}
LAC 1,FONT ;CURRENT FONT NUMBER.
SKIPN 2,FONTAB(1)↔POP1J ;FONT BASE ADDRESS.
LAC I,203(2) ;ROWS BETWEEN TOP AND BASE LINE.
ADD 2,ARG1 ;POINTER INTO FONT'S CHARACTER TABLE.
CAR N,(2) ;COLS WIDE OF THE GLYPH.
CDR G,(2)↔JUMPE G,POP1J.;EXIT WHEN NO CHARACTER.
ADD G,FONTAB(1)↔AOS G ;CHARACTER'S GLYPH POINTER.
CDR M,(G) ;ROWS HIGH OF THE GLYPH.
CAR 0,(G) ;ROWS FROM TOP TO FIRST ROW OF GLYPH.
SUB 0,I ;ROWS ABOVE CURRENT XGP PEN POSITION.
ADD 0,ROW
IMULI WWIDTH
ADD ORGXGP↔DAPZ B ;WORD POINTER INTO XGP BUFFER.
LAC 0,COL↔IDIVI 0,=36 ;REMAINDER IN AC-1 !
AOS↔ADD B,0↔DAC B,B2 ;WORD POINTER INTO XGP BUFFER.
ADDM N,COL ;UPDATE XGP PEN COLUMN POSITION.
TLO G,444400↔AOS G ;SETUP GLYPH BYTE POINTER.
CAILE N,=36↔GO[
IDIVI N,=36↔AOJA N,L0] ;WHEN CHARACTER WIDTH ≥ =36.
DPB N,[POINT 6,G,11] ;SIZE OF BYTE.
ADD 1,N↔SUBI 1,=36 ; =36 - CHRWID - REMAINDER
LACI N,1
L0: MOVNS 1↔DAP 1,L3 ;BYTE POSITION WITH RESPECT TO WORD BOUNDARYS.
;INCLUSIVE OR GLYPH BITS INTO THE XGP BUFFER.
L1: LAC I,N
L2: ILDB 0,G↔SETZ 1,
L3: LSHC 0,0
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 0,(B)
AOS B↔JUMPE 1,L4
CAML B,ORGXGP↔CAMLE B,ENDXGP↔SKIPA↔IORM 1,(B)
L4: SOJG I,L2↔LAC B,B2
ADDI B,WWIDTH↔DAC B,B2
SOJG M,L1↔POP1J
BEND PRINT;BGB 23 MAY 1973.---------------------------------------
SUBR(LSD) LINE SEGMENT DISPLAY.
COMMENT / Recursive midpoint method of quantizing a line segment.
Arguments are expected in accumulators R1, C1, R2, C2; the bit
is deposited from accumulator 0./
BEGIN LSD;________________________________________________________
ACCUMULATORS{R1,C1,R2,C2,Q,N}
;TEST FOR AND HANDLE SIMPLE CASES.
CAMN R1,R2↔GO[
CAMN C1,C2↔GO[DOT(R1,C1)↔POP0J]↔GO HSEG]
CAMN C1,C2↔GO VSEG
;MIDPOINT THE HARD CASE.
PUSH P,R1↔PUSH P,C1 ;SAVE 1ST END.
ADD R1,R2↔ASH R1,-1 ;MIDPOINT THE LINE SEGMENT.
ADD C1,C2↔ASH C1,-1
;TEST FOR MIDPOINT AND 1ST END BEING COINCIDANT.
CAMN R1,-1(P)↔GO[
CAME C1, 0(P)↔GO .+1↔POP P,C1↔POP P,R1
DOT(R1,C1)↔DOT(R2,C2)↔POP0J]
;RECURSION - DISPLAY ONE HALF AND THEN DISPLAY THE OTHER.
CALL(LSD) ;MIDPOINT TO 2ND END.
LAC R2,-1(P)↔LAC C2,0(P)
CALL(LSD) ;MIDPOINT TO 1ST END.
POP P,C1↔POP P,R1↔POP0J
;DISPLAY HORIZONTAL LINE SEGMENT FROM (C1 MIN C2) TO (C1 MAX C2).
HSEG: LAC Q,C1↔LAC N,C2
CAML C1,C2↔EXCH N,Q↔SUB N,Q
DOT(R1,Q)↔SKIPA↔IDPB 0,1
SOJG N,.-1↔POP0J
;DISPLAY VERTICAL LINE SEGMENT FROM (R1 MIN R2) TO (R1 MAX R2).
VSEG: LAC Q,R1↔LAC N,R2
CAML R1,R2↔EXCH N,Q↔SUB N,Q
DOT(Q,C1)↔ADDI 1,WWIDTH
SOJG N,.-2↔POP0J
BEND LSD;BGB 24 APRIL 1973._______________________________________
SUBR(IIISIM) OUTPUT III BUFFER ONTO XGP.
BEGIN IIISIM______________________________________________________
;DELTA ORIGIN DISPLACEMENT.
SLACI 1,(2B2)↔LAC CHAR
CAIN"*"↔SETZ 1,↔DAC 1,DELTA#
;IIIFILE NAME.
CALL(GETFIL)↔POP0J
CALL(INITIO,[17],[SIXBIT/DSK/],[0])
GO[FATAL(CAN'T INIT DSK)]
DAC 1,IIICHN#
CALL(IO,[LOOKUP FILNAM],IIICHN)↔GO FRET
;EXPAND CORE FOR DUMP INPUT.
LAC JOBREL↔DAC OLD44#
NIP 1,PPPN↔MOVN 1,1
ADD 1,JOBREL↔DAC 1,BUFEND#
CORE 1,↔GO[FATAL(CAN'T EXPAND CORE)]
;SAVE CURRENT BEAM POSITION.
LAC COL↔DAC BEGCOL#
LAC ROW↔DAC BEGROW#
;DUMP III FILE IN.
LAC OLD44↔ADDM PPPN
CALL(IO,[IN PPPN],IIICHN)
LAC 1,OLD44↔ADDI 1,2↔DAC 1,PC# ;III PC.
OUTSTR[ASCIZ/READING III BUFFER.../]
L1: CDR 1,BUFEND↔DZM -1(1)↔DZM(1)
CAML 1,JOBREL↔GO .+3
LIPI 1,-1(1)↔BLT 1,JOBREL ;CLEAR TOP.
;FETCH AND DECODE III COMMAND WORD.
ILOOP: AOSA 1,PC
LOOP: LAC 1,PC↔CAMLE 1,JOBFF
CAML 1,BUFEND↔GO RET
LAC 2,(1)
TRNE 2,01↔GO XTEXT ;TEXT COMMAND WORD.
TRNE 2,02↔GO XVECTR ;VECTOR COMMAND WORD.
TRNE 2,20↔GO XCTRL ;III CONTROL WORD.
TRNE 2,37↔GO ILOOP ;NOP & HALT COMMANDS.
RET: OUTSTR[ASCIZ/FINISHED
/]
FRET: CALL(IO,[RELEASE],IIICHN)↔JFCL
LAC OLD44↔CORE↔GO[FATAL(CAN'T SHRINK CORE!)]
LAC BEGCOL↔DAC COL
LAC BEGROW↔DAC ROW
POP0J
;EXECUTE III TEXT.
XTEXT: PUSH P,2 ;-2(P)
PUSH P,[5] ;-1(P)
PUSH P,[POINT 7,-2(P)] ; 0(P)
CLOOP: ILDB 1,0(P)↔JUMPE 1,CCONT
CAIN 1,15↔GO[LAC -4(P)↔DAC COL↔GO CCONT]
CALL(PRINT,1)
CCONT: SOSLE -1(P)↔GO CLOOP
SUB P,[XWD 3,3]
GO ILOOP
;EXECUTE III CONTROL OPERATIONS.
XCTRL: TRNN 2,04↔GO[CAR 1,2↔DAC 1,PC↔GO LOOP] ;JUMP.
TRNE 2,40↔GO LOOP ;SAVE A NOP HERE
AOS 1,PC ;JSR
HRLI 1,20
CAR 2,2
CAMLE 2,JOBFF
CAML 2,BUFEND↔GO[ OUTSTR[ASCIZ/JSR OUT OF BOUNDS
/]↔ GO RET]
DAC 1,(2)↔DAC 2,PC
GO ILOOP
;EXECUTE VECTORS.
XVECTR: TRNN 2,4
GO [TRNN 2,10 ;SHORT VECTOR OR TSS
GO SVECT ;SHORT VECTOR
GO ILOOP] ;TSS
LDB [POINT 11,2,10]↔ROT -13 ;X
ADD DELTA↔MUL SCALEX↔PUSH P,0
LDB [POINT 11,2,21]↔ROT -13↔MOVNS ;Y
ADD DELTA↔MUL SCALEY↔PUSH P,0
LDB 1,[POINT 3,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP
SVECT: PUSH P,2
LDB [POINT 7,2,6]↔ROT -7
ADD DELTA↔MUL SCALEX↔PUSH P,0 ;X
LDB [POINT 7,2,13]↔ROT -7↔MOVN
ADD DELTA↔MUL SCALEY↔PUSH P,0 ;Y
LDB 1,[POINT 2,2,15]
PUSHJ P,@PLOTAB(1)
POP P,2
LDB [POINT 7,2,22]↔ROT -7
ADD DELTA↔MUL SCALEX↔PUSH P,0 ;X
LDB [POINT 7,2,29]↔ROT -7↔MOVN
ADD DELTA↔MUL SCALEY↔PUSH P,0 ;
LDB 1,[POINT 2,2,31]
PUSHJ P,@PLOTAB(1)
GO ILOOP
PLOTAB: [RVECT: CALL(RELATE)↔CALL(PLTVEC,1,2)↔POP2J]
[RPNT: CALL(RELATE)↔DAC 1,COL↔DAC 2,ROW↔GO PLTVEC]
[RIVECT: CALL(RELATE)↔DAC 1,COL↔DAC 2,ROW↔POP2J]
RPNT
[AVECT: CALL(ABSOLUTE)↔GO PLTVEC] ;ARGS ARE ALREADY STACKED
[APNT: CALL(ABSOLUTE)↔DAC 1,COL↔DAC 2,ROW↔GO PLTVEC]
[AIVECT: CALL(ABSOLUTE)↔DAC 1,COL↔DAC 2,ROW↔POP2J]
APNT
RELATE: SKIPE DELTA↔MOVSI -200000↔MUL SCALEX
LAC 1,0↔ADD 1,COL↔ADDB 1,-3(P)
SKIPE DELTA↔MOVSI -200000↔MUL SCALEY
LAC 2,0↔ADDB 2,-2(P)↔ADD 1,ROW
POP0J
ABSOLU: LAC 1,BEGCOL↔ADDB 1,-3(P)
LAC 2,BEGROW↔ADDB 2,-2(P)
POP0J
BEND;2/8/73/(TVR)21 MAY 1973(BGB)---------------------------------
PLTVEC: SETO↔LAC 2,ROW↔LAC 3,COL↔LAC 4,ARG1↔LAC 5,ARG2
DAC 4,ROW↔DAC 5,COL↔CALL(LSD)↔POP2J
SUBR(GETFIL) ;GET FILE SPEC FROM TTY LINE.
BEGIN GETFIL;_____________________________________________________
SETZM FILNAM↔SETZM EXTION
SETZM EXTION+1↔SETZM PPPN
LAC 4,[POINT 6,FILNAM,-1]↔LACI 2,6
CALL(GETCHR)↔POP0J
CAIN 1,15↔GO[CALL(GETCHR)↔POP0J↔POP0J]↔AOS(P)
JRST L+2
L: CALL(GETCHR)↔POP0J↔CAIN 1,";"↔POP0J
CAILE 1,"z"↔POP0J
CAIL 1,"a"↔SUBI 1,40 ;CONVERT LOWER CASE
CAIN 1,"."↔GO[LAC 4,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
CAIN 1,"["↔GO[LAC 4,[POINT 6,PPPN,-1] ↔LACI 2,3↔GO L]
CAIN 1,","↔GO[CAR PPPN
PUSHJ P,[PPJUST: JUMPE [OUTSTR[ASCIZ/BAD P,PN/]
CLRBFI↔SOS -1(P)↔CRLF↔POP1J]
TRNE 77↔POP0J↔LSH -6↔GO PPJUST]
DIP PPPN↔LAC 4,[POINT 6,PPPN,17]↔LACI 2,3↔GO L]
CAIN 1,"]"↔GO[CDR PPPN↔CALL(PPJUST)
DAP PPPN↔CALL(GETCHR)↔POP0J↔GO FINQ]
FINQ: CAIN 1,15↔GO EOL ;END OF THE LINE.
CAIN 1,12↔POP0J
CAIN 1,"→"↔POP0J
CAIG 1," "↔GO L ;IGNORE GARBAGE.
SOJL 2,L↔SUBI 1,40↔IDPB 1,4↔GO L
EOL: CALL(GETCHR)↔POP0J↔POP0J
BEND;1/31/73,2/7/73(TVR)----------------------------------------------
SUBR(INITIO) GET AND OPEN A CHANNEL.
BEGIN INITIO;_____________________________________________________
MOVEI 1,17 ;SEARCH FOR FREE CHANNEL
SKIPE JOBJDA(1)
SOJGE 1,.-1
JUMPL 1,[OUTSTR[ASCIZ+OUT OF I/O CHANNELS!
+]↔ POP3J]
LAC [ OPEN -3(P)]
DPB 1,[POINT 4,0,12]
XCT 0
POP3J
AOS (P)
POP3J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(IO,OPCODE,CHAN)----------------------------------------------
BEGIN IO
LAC -1(P)
DPB [POINT 4,-2(P),12]
XCT -2(P)
POP2J
AOS (P)
POP2J
BEND;2/7/73/(TVR)-------------------------------------------------
SUBR(GETCHR) GET CHARACTER AND SKIP.
BEGIN GETCHR;_____________________________________________________
;TELETYPE.
L1: SKIPN TTYFLG↔GO L2
INCHSL 1↔POP0J
CAIN 1,15↔POP0J
AOS(P)↔POP0J
;DISK.
L2: SKIPGE 1,IOPTR↔GO[SETOM TTYFLG↔GO L1] ;RETURN TO TTY.
SOSLE IBUF+2(1)↔GO RETCHR
CALL(IO,[IN],<CHANTB(1)>)↔GO RETCHR
CALL(IO,[STATO 1B22],<CHANTB(1)>)↔GO[
OUTSTR[ASCIZ/DISK READ ERROR /]↔HALT RETCHR]
CALL(IO,[RELEASE],<CHANTB(1)>) ;EOF.
SUBI 1,4↔DAC 1,IOPTR ;POP A CHANNEL.
GO GETCHR
RETCHR: ILDB 1,IBUF+1(1) ;RETURN A CHARACTER.
AOS(P)↔POP0J ;AND SKIP.
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(GETCHM) GET CHARACTER MUST.
BEGIN GETCHM
CALL(GETCHR)
GO [FATAL(UNEXPECTED EOF)]
POP0J
BEND GETCHM;2/7/73(TVR)-------------------------------------------
SUBR(GETNUM) GET AN INTEGER.
BEGIN GETNUM
SETZM 3↔CALL(GETCHM)
CAIL 1,"0"↔CAILE 1,"9"↔GO[
EXCH 1,3↔POP0J]↔ANDI 1,17
IMULI 3,=10↔ADD 3,1
GO GETNUM+1
BEND GETNUM;_________________________________________________________
SUBR(GET14) GET A 14 BIT NUMBER
BEGIN GET14
CALL(GETCHM)
LSH 1,7
PUSH P,1
CALL(GETCHM)
ADD 1,(P)
POP P,(P)
POP0J
BEND GET14;__________________________________________________________
SUBR(INITXT) INITIALIZE TEXT FILE.
BEGIN INITXT;_____________________________________________________
LACI 2,4↔ADD 2,IOPTR
CAIL 2,4*MAXFILES↔GO[FATAL(INDIRECTION TOO DEEP.)]
LACI IBUF(2)
CALL (INITIO,[0],[SIXBIT/DSK/],0)
GO[FATAL(CAN'T INIT DSK)]
DAC 1,CHANTB(2)
CALL(GETFIL)↔GO L2
LACI 2,4↔ADDB 2,IOPTR
CALL (IO,[LOOKUP FILNAM],<CHANTB(2)>)
GO L2↔GO L4
L2: OUTSTR[ASCIZ/FILE NOT FOUND. /]
LACI 2,4↔SUBM 2,IOPTR
L3: CALL(IO,[RELEASE],<CHANTB(2)>)
L4: AOS(P)↔POP0J
BEND;2/7/73(TVR)--------------------------------------------------
SUBR(DEFONT) DEFINE FONT N.
BEGIN DEFONT;_____________________________________________________
DZM FILNAM
;DISK INITIALIZATION.
PUSH P,[17]↔PUSH P,[SIXBIT/DSK/]↔PUSH P,[0]
PUSHJ P,INITIO↔GO[FATAL(CAN'T INIT DSK)]↔DAC 1,FONTCH
SKIPE FILNAM↔GO L1
CALL(GETCHM)↔ANDI 1,17↔DAC 1,FONT ;FONT NUMERAL.
CALL(GETFIL)↔GO L3 ;FONT FILE NAME.
;FIND FONT FILE.
L1: CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
LACI'FNT'↔SKIPN EXTION↔DIPZ EXTION
CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
LAC FNTPPN↔SKIPN PPPN↔DAC PPPN
CALL(IO,[LOOKUP FILNAM],FONTCH)↔GO[
OUTSTR[ASCIZ/ FONT NOT FOUND.
/]↔ GO L3]↔GO .+1]↔GO .+1]
L2: LAC 1,FONT ;FONT NUMBER.
LAC MAXADR↔DAC FONTAB(1) ;FONT BASE ADDRESS.
HLL PPPN↔SOS↔DAC INARG ;IOWD DUMP ARGUMENT.
MOVS PPPN↔MOVMS↔ADD MAXADR↔AOS ;TOP OF THE FONT.
DAC MAXADR↔CORE2↔HALT ;EXPAND UPPER SEGMENT.
CALL(IO,[IN INARG]],FONTCH])↔JFCL
CALL(SETFNT)
L3: CALL (IO,[RELEASE],FONTCH)
POP0J
↑FONTCH: 0
MAXADR: %+4000
INARG:0↔0
BEND DEFONT;2/7/73(TVR)2/25/73(BGB)-------------------------------
SUBR(SETFNT) SETUP A FONT.
BEGIN SETFNT;_____________________________________________________
LAC 1,FONT↔CDR 2,FONTAB(1) ;GET FONT BASE ADDRESS.
SKIPN 2↔POP0J ;EXIT WHEN FONT MISSING.
LACI =40↔DAC DROW ;LINE FEED DEFAULT.
SKIPE 1,201(2)↔DAC DROW ;LINE FEED SPECIFIED.
LACI =25↔DAC DCOL ;SPACE DEFAULT.
SKIPE 1,202(2)↔DAC 1,DCOL ;SPACE SPECIFIED.
POP0J
BEND SETFNT;2/7/72(TVR)-------------------------------------------
; --- ASCII 00 TO 37.
A00:
0 ;null. ;00-07.
0 ;"↓"
0 ;"α"
0 ;"β"
0 ;"∧"
0 ;"¬"
0 ;"ε"
0 ;"π"
0 ;"λ" ;10↔17.
0 ;tab.
0 ;LF
0 ;VT.
0 ;FF.
0 ;CR.
0 ;"∞"
0 ;"∂"
0 ;"⊂" ;20-27.
0 ;"⊃"
0 ;"∩"
0 ;"∪"
0 ;"∀"
0 ;"∃"
IIISIM ;"⊗"
0 ;"↔"
0 ;"_" ;30-37.
0 ;"→"
0 ;"~" TILDE.
0 ;"≠"
0 ;"≤"
0 ;"≥"
0 ;"≡"
0 ;"∨"
; --- ASCII 40 TO 77.
0 ;SPACE. ;40-47.
0 ;"!"
0 ;"""
0 ;"#"
0 ;"$"
0 ;"%"
0 ;"&"
0 ;"'"
0 ;"(" ;50-57.
0 ;")"
IIISIM ;"*"
0 ;"+"
0 ;","
0 ;"-"
0 ;"."
0 ;"/"
0 ;"0" ;60-67.
0 ;"1"
0 ;"2"
0 ;"3"
0 ;"4"
0 ;"5"
0 ;"6"
0 ;"7"
0 ;"8" ;70-77.
0 ;"9~
0 ;":~
0 ;";~
0 ;"<"
0 ;"="
0 ;">"
0 ;"?"
; --- ASCII 100 TO 137. UPPER CASE COMMANDS.
REQFIL ;"@" INDIRECT FILE COMMAND ;100-107.
0 ;"A"
0 ;"B"
0 ;"C"
0 ;"D"
0 ;"E"
XFONT ;"F" SELECT FONT AND ENTER TEXT MODE.
0 ;"G"
0 ;"H" ;110-117.
AI ;"I" ABSOLUTE INVISIBLE VECTOR.
0 ;"J"
0 ;"K"
0 ;"L"
DEFONT ;"M"
0 ;"N"
0 ;"O"
0 ;"P" ;120-127.
0 ;"Q"
0 ;"R"
XSCALE ;"S"
0 ;"T"
0 ;"U"
AV ;"V" ABSOLUTE VISIBLE VECTOR.
0 ;"W"
0 ;"X" ;130-137.
0 ;"Y"
0 ;"Z"
0 ;"["
0 ;"\"
0 ;"]"
0 ;"↑"
0 ;"←"
; --- ASCII 140 TO 177. LOWER CASE COMMANDS.
0 ;"'" ;140-147.
0 ;"a"
0 ;"b"
0 ;"c"
0 ;"d"
0 ;"e"
0 ;"f"
0 ;"g"
0 ;"h" ;150-157.
0 ;"i"
0 ;"j"
0 ;"k"
0 ;"l"
0 ;"m"
0 ;"n"
0 ;"o"
0 ;"p" ;160-167.
0 ;"q"
0 ;"r"
0 ;"s"
0 ;"t"
0 ;"u"
0 ;"v"
0 ;"w"
0 ;"x" ;170-177.
0 ;"y"
0 ;"z"
0 ;"{"
0 ;"|"
0 ;alt
0 ;"}"
0 ;rubout
; COMMAND EXECUTION.
;"@" INDIRECT FILE COMMAND.
REQFIL: CALL(INITXT)↔GO[OUTSTR[ASCIZ/ FILE NOT FOUND.
/]↔POP0J]
SETZM TTYFLG ;READ FROM DISK.
SETZM MODE ;ENTER TEXT MODE.
POP0J
XFONT: CALL(GETCHM) ;SELECT FONT.
ANDI 1,17↔DAC 1,FONT
SETZM MODE ;ENTER TEXT MODE.
POP0J
;ABSOLUTE INVISIBLE VECTOR.
AI: CALL(GETNUM)↔DAC 1,ROW
CALL(GETNUM)↔DAC 1,COL↔POP0J
;ABSOLUTE VISIBLE VECTOR.
AV: CALL(GETNUM)↔DAC 1,4
CALL(GETNUM)↔DAC 1,5
SETO
LAC 2,ROW↔LAC 3,COL
DAC 4,ROW↔DAC 5,COL
CALL(LSD)↔POP0J
;III DISPLAY SCALE FACTOR.
XSCALE: CALL(REALIN)↔FMPR[1024.]
FIXX↔ MOVMM SCALEY
SKIPL↔ MOVMM SCALEX
POP0J
SUBR(MODE0)
BEGIN MODE0;
CALL(GETCHR) ;GET MODE 0 ESCAPE
DAC 1,CHAR ;SAVE IT IN CASE ITS A HIDDEN CHARACTER
JUMPE 1,HIDDEN
CAIN 1,1↔GO ESC1
CAIN 1,2↔GO ESC2
CAIL 1,20 ;TREAT '177 '20 THRU '177 '24 AS LINE SPACE
CAILE 1,24
GO [ LAC DCOL↔ADDM COL↔GO COLCHK ]
GO HIDDEN
COMMENT ⊗
XGP ESCAPE 1 ('177&'001) causes the next 7 bits to be read as a special
operation code. The following codes are proposed:
0-17 Font select. The code, 0 to 17 is taken as the font
identification number of the font to use.
20-37 Reserved for future use.
40 XGP Column Selector
The next 14 bits are taken modulo 4096 as the x position
to print at next. (The intention is to allow arbitrary
width spaces for text justification.)
41 XGP Underscore
The next 7 bits are taken as the scan line number on which
to underscore. (Scan line 0 is the first scan-line in the
character). The next 14 bits are taken modulo 4096 as the
length of the underscore.
42 Line space.
This does a line feed and then takes the next 7 bits as the
number of blank lines to insert before the next line.
43 Base-line adjust.
The next 7 bits are taken in two's complement as the base-
line adjustment to the current font. The adjustment sticks
until reset by another adjust command or a font select. The
intention is to allow a font to be used for subscripts and
superscripts. (Increment baseline for superscript, decrement
for subscript).
44 Insert the paper page number. The paper page number is set
to 1 by a form feed. It is incremented each time the paper
is cut. This escape causes the decimal value of this count
to be printed.
45 Accept heading text. The next byte is a count of bytes to
follow. That number of bytes will be read into the heading
line. When that count is exhausted, the heading line will
be printed.
⊗;
ESC1: CALL(GETCHM)
CAIGE 1,20↔GO [ DAC 1,FONT↔POP0J ]
CAIN 1,40↔GO COLSEL
CAIN 1,41↔GO UNDERSCORE
CAIN 1,42↔GO LINESPACE
FATAL(UNIMPLIMENT MODE 0 COMMAND)
COLSEL: CALL(GET14)
DAC 1,COL
GO COLCHK
UNDERSCORE: FATAL(UNDERSCORE UNIMPLIMENTED)
LINESPACE: CALL(GETCHM)
ADD DROW
ADDM ROW
GO ROWCHK
COMMENT ⊗
XGP ESCAPE 2 ('177&'002) causes the next 7 bits to be taken as the column
increment. This quantity is signed: 0-77 are positive increments 100
to 177 are negative increments (100 → -100, 177 → -1).
The escape significance of codes 3 through 10, 13, and 16 through 37 is not
defined at the present time but reserved for future use.
⊗;
ESC2: CALL(GETCHM)
CAIL 1,100
OR 1,[ 777777777700 ]
ADDM 1,COL
GO COLCHK
BEND MODE0;
;SUBR(SQRT)
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
A←0 ↔ B←1 ↔ C←2
MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
INTERN SIN,COS;---------------------------------------------------
A←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325 ;PI/2
LIT
BEND;-------------------------------------------------------------
SUBR(REALIN)
BEGIN REALIN;
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,15↔INCHWL 1
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0: INCHWL 1
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
CAIN 1,"π"↔GO[MOVE 0,[3.1415926]
GETRET: INCHWL 1↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔ POP0J]
SKIPA
L1: INCHWL 1
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
END SA